{Version 7.71}
{
                          LITESBS1.PAS
                   Copyright (c) 1995-2007 by
                        L. David Baldwin

Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, sublicense,
and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
DEALINGS IN THE SOFTWARE.
}

{$i LiteCons.inc}

unit LiteSbs1;

interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, LiteUn2, LiteGif2, LiteSubs;

Type

  TParagraphSpace = class(TSectionBase)  {spacing for a <p>}
    procedure UpdateSpacing; override;
    procedure CopyToClipboard; override;
    end;

  THeadingSpace = class(TSectionBase)     {spacing for <Hn>}
    HeadingSize: integer;

    constructor Create(AMasterList: TSectionList; AHeadingSize: integer);
    procedure CopyToClipboard; override;
    procedure UpdateSpacing; override;
    end;

  THorzLine = class(TSectionBase)          {a horizontal line, <hr>}
    VSize: integer;
    HWidth: integer;
    AsPercent: boolean;
    Color: TColor;
    Align: JustifyType;
    NoShade: boolean;        
    BkGnd: boolean;
    constructor Create(AMasterList: TSectionList; L: TAttributeList);
    procedure CopyToClipboard; override;
    function DrawLogic(Canvas : TCanvas; Y: integer; IMgr: IndentManager;
             var MaxWidth: integer; var Curs: integer): integer; override;
    function Draw(Canvas: TCanvas; const ARect: TRect;
         IMgr: IndentManager; X : integer; Y: integer) : integer;  override;
    procedure UpdateSpacing; override;
    end;

   TPreFormated = class(TSection)
  {section for preformated, <pre>}
  public
    procedure AddTokenObj(S : TokenObj; NoBreak: boolean); override;   
    function DrawLogic(Canvas : TCanvas; Y: integer; IMgr: IndentManager;
             var MaxWidth: integer; var Curs: integer): integer; override;
    procedure MinMaxWidth(Canvas: TCanvas; var Min, Max: integer); override;
    end;

 TUListItem = class(TSection)     {Unordered List}
    Plain: boolean;
    constructor Create(AMasterList: TSectionList; Level: integer; AFont: TMyFont;
                         AnURL: TUrlTarget);
    end;

  TDListItem = class(TUListItem)     {Definition List}
    constructor Create(AMasterList: TSectionList; Level: integer; AFont:
                TMyFont; AnURL: TUrlTarget);
    end;

  TOListItem = class(TUListItem)    {Ordered List}
    IndexType: char;  {1,a,A,i,I}
    constructor Create(AMasterList: TSectionList; Level, ItemNumb: integer;
                Index: char; AFont: TMyFont; AnURL: TUrlTarget);
    end;

  TListBoxFormControlObj = class(TFormControlObj)
  {<select> with Multiple set or Size > 1}
  public
    LBSize, Longest: integer;
    TheOptions: TStringList;
    constructor Create(AMasterList: TSectionList; Position: integer; L: TAttributeList);
    destructor Destroy; override;
    procedure AddStr(const S, Value: string; Selected: boolean);
    procedure ResetToValue; override;
    procedure SetHeightWidth(Canvas: TCanvas); override;
    function GetSubmission(Index: integer; var S: string): boolean; override;
  end;

  TComboFormControlObj = class(TListBoxFormControlObj)
  {<select> with size = 1, no multiple}
  public
    constructor Create(AMasterList: TSectionList; Position: integer; L: TAttributeList);
    procedure ResetToValue; override;
    procedure SetHeightWidth(Canvas: TCanvas); override;
    function GetSubmission(Index: integer; var S: string): boolean; override;
  end;

  TTextAreaFormControlObj = class(TFormControlObj)
  public
    Rows, Cols: integer;
    TheText: TStringList;
    constructor Create(AMasterList: TSectionList; Position: integer; L: TAttributeList);
    destructor Destroy; override;
    procedure AddStr(const S: string);
    procedure ResetToValue; override;
    procedure SetHeightWidth(Canvas: TCanvas); override;
    function GetSubmission(Index: integer; var S: string): boolean; override;
  end;

  TFormControlList = class(TList)  {a list of TFormControlObj's}  {not TFreeList}
  Public
    function FindControl(Posn: integer): TFormControlObj;
    function GetHeightAt(Posn: integer; var BaseLine: boolean) : Integer;
    function GetWidthAt(Posn: integer) : integer;
    function GetControlCountAt(Posn: integer): integer;
    end;

Implementation

uses
  LitePars, htmllite;

{----------------TParagraphSpace.UpdateSpacing}
procedure TParagraphSpace.UpdateSpacing;
begin
SectionHeight := MulDiv(14, ParentSectionList.FontSize, 12);   {scale to FontSize}
end;

procedure TParagraphSpace.CopyToClipboard;
begin
ParentSectionList.CB.AddTextCr('', 0);
end;

{----------------THeadingSpace.Create}
constructor THeadingSpace.Create(AMasterList: TSectionList; AHeadingSize: integer);
begin
inherited Create(AMasterList);
HeadingSize := AHeadingSize;
end;

procedure THeadingSpace.CopyToClipboard;
begin
ParentSectionList.CB.AddTextCR('', 0);
end;

procedure THeadingSpace.UpdateSpacing;
var
  SH: integer;
begin
case HeadingSize of    {these are just a guess}
  0: SH := 8;
  1: SH := 16;
  2: SH := 12;
  3: SH := 10;
  4: SH := 8;
  5: SH := 6;
  6: SH := 4;
  else SH := 8;
  end;
SectionHeight := MulDiv(SH, ParentSectionList.FontSize, 12);   {scale to FontSize}
end;

{----------------THorzLine.Create}
constructor THorzLine.Create(AMasterList: TSectionList; L: TAttributeList);
var
  LwName: string[10];
  I: integer;
begin
inherited Create(AMasterList);
VSize := 2;
HWidth := -1;
Align := Centered;
for I := 0 to L.Count-1 do
  with TAttribute(L[I]) do
    case Which of
      SizeSy: if (Value > 0) and (Value <= 20) then
        VSize := Value;
      WidthSy:
        if Value > 0 then
          if Pos('%', Name) > 0 then
            begin
            if (Value <= 100) then HWidth := Value;
            AsPercent := True;
            end
          else HWidth := Value;
      ColorSy: BkGnd := GetColor(Name, Color);
      AlignSy:
        begin
        LwName := Lowercase(Name);
        if LwName = 'left' then Align := Left
        else if LwName = 'right' then Align := Right;
        end;
      NoShadeSy: NoShade := True;
      end;
end;

{----------------THorzLine.UpdateSpacing}
procedure THorzLine.UpdateSpacing;
begin
SectionHeight := MulDiv(20, ParentSectionList.FontSize, 12)
                   -2 + VSize;   {scale to FontSize}
end;

procedure THorzLine.CopyToClipboard;
begin
ParentSectionList.CB.AddTextCR('', 0);
end;

function THorzLine.DrawLogic(Canvas : TCanvas; Y: integer; IMgr: IndentManager;
             var MaxWidth: integer; var Curs: integer): integer;
begin
Result := inherited DrawLogic(Canvas, Y, IMgr, MaxWidth, Curs);
end;

{----------------THorzLine.Draw}
function THorzLine.Draw(Canvas: TCanvas; const ARect: TRect;
     IMgr: IndentManager; X: integer; Y: integer) : integer;
var
  XR, L, R, W2 : integer;
  YT, YO: integer;
  White, BlackBorder: boolean;
begin
Result := inherited Draw(Canvas, ARect, IMgr, X, Y);
YO := Y - ParentSectionList.YOff;
if (YO+SectionHeight >= ARect.Top) and (YO < ARect.Bottom) then
  with Canvas do
    begin
    YT := YO+(SectionHeight - VSize) div 2;
    L := IMgr.LeftIndent(Y);
    R := IMgr.RightSide(Y);
    if HWidth < 0 then
      begin
      X := L+10;
      XR := R - 10;
      end
    else
      begin
      if AsPercent then
        W2 := MulDiv(R-L, HWidth, 100)
      else W2 := HWidth;
      case Align of
        Left: X := L;
        Centered: X := L + (R - L - W2) div 2;
        Right: X := R-W2;
        end;
      XR := X+W2;
      end;
    if BkGnd then
      begin
      Brush.Color := Color or $2000000;
      Brush.Style := bsSolid;
      FillRect(Rect(X, YT, XR, YT+VSize));
      end
    else
      begin
      with ParentSectionList do
        begin
        White := ((Background and $FFFFFF = clWhite) or
            ((Background = clWindow) and (GetSysColor(Color_Window) = $FFFFFF)));
        BlackBorder := NoShade or ((GetDeviceCaps(Handle, BITSPIXEL) = 1) and
            (GetDeviceCaps(Handle, PLANES) = 1));
        end;
      if BlackBorder then Pen.Color := clBlack
        else Pen.Color := clBtnShadow;
      MoveTo(X, YT+VSize);
      LineTo(X, YT);
      LineTo(XR, YT);
      if BlackBorder then
        Pen.Color := clBlack
      else if White then
        Pen.Color := clSilver
      else Pen.Color := clBtnHighLight;
      LineTo(XR, YT+VSize);
      LineTo(X, YT+VSize);
      end;
    end;
end;

procedure TPreformated.AddTokenObj(S : TokenObj; NoBreak: boolean);
var
  L : integer;
begin
if Length(S.S) = 0 then Exit;
if Len > 20000 then  Exit;
L := Len+Length(S.S);
if BuffSize < L+1 then Allocate(L + 100);  {L+1 so there is always extra for font at end}
Move(S.S[1], (Buff+Len)^, Length(S.S));
Move(S.I[1], XP^[Len], Length(S.S)*Sizeof(integer));    
Len := L;
end;

procedure TPreformated.MinMaxWidth(Canvas: TCanvas; var Min, Max: integer);
begin
if Len = 0 then    
  begin
  Max := Indent;
  Min := Indent;
  end
else
  begin
  Max := FindTextWidth(Canvas, Buff, Len, False) + Indent;
  Min := IntMin(2000, Max);   {arbitrary selection}
  end;
end;

function TPreFormated.DrawLogic(Canvas : TCanvas; Y: integer; IMgr: IndentManager;
             var MaxWidth: integer; var Curs: integer): integer;
var
  Dummy: integer;
  Save: integer;
begin
if Len = 0 then
  begin
  Result := DefFont.Size;
  SectionHeight := Result;
  MaxWidth := 0;
  end
else
  begin
  {call with large width to prevent wrapping}
  Save := IMgr.Width;
  IMgr.Width := 32000;
  Result := inherited DrawLogic(Canvas, Y, IMgr, Dummy, Curs);
  IMgr.Width := Save;
  MinMaxWidth(Canvas, Dummy, MaxWidth);   {return MaxWidth}
  end;
end;

{----------------TUListItem.Create}
constructor TUListItem.Create(AMasterList: TSectionList; Level: integer;
            AFont: TMyFont; AnURL: TUrlTarget);
begin
inherited Create(AMasterList, Level, AFont, AnURL, Left);
ListType := Unordered;
end;

constructor TDListItem.Create(AMasterList: TSectionList; Level: integer;
                                           AFont: TMyFont; AnURL: TUrlTarget);
begin
inherited Create(AMasterList, Level, AFont, AnURL);  {ancestor is TUListItem}
ListType := Definition;
end;

constructor TOListItem.Create(AMasterList: TSectionList; Level, ItemNumb:integer;
            Index: char; AFont: TMyFont; AnURL: TUrlTarget);
begin
inherited Create(AMasterList, Level, AFont, AnURL);
ListNumb := ItemNumb;
ListType := Ordered;
IndexType := Index;
end;

type
  TOptionObj = class(TObject)   {used by TListBoxFormControlObj}
    Value: String;
    Selected: boolean;
  end;

{----------------TListBoxFormControlObj.Create}
constructor TListBoxFormControlObj.Create(AMasterList: TSectionList;
            Position: integer; L: TAttributeList);
var
  T: TAttribute;
  Multiple: boolean;
  PntPanel: TPaintPanel;
begin
inherited Create(AMasterList, Position, L);
TheOptions := TStringList.Create;
Multiple := L.Find(MultipleSy, T);
if L.Find(SizeSy, T) then
  LBSize := T.Value
else LBSize := -1;
Longest := 3;   {the minimum size}
PntPanel := TPaintPanel(AMasterList.PPanel);
FControl := TListBox.Create(PntPanel);
with TListBox(FControl) do
  begin
  Top := -400;   {so will be invisible until placed}
  Font.Name := AMasterList.PreFontName;
  Font.Size := 10;
  MultiSelect := Multiple;
  ExtendedSelect := Multiple;
  OnEnter := EnterEvent;    
  OnExit := ExitEvent;
  OnClick := FormControlClick;   
  end;
end;

destructor TListBoxFormControlObj.Destroy;
var
  I: integer;
begin
for I := 0 to TheOptions.Count-1 do
  with TOptionObj(TheOptions.Objects[I]) do
    Free;
TheOptions.Free;
inherited Destroy;
end;

procedure TListBoxFormControlObj.AddStr(const S, Value: string; Selected: boolean);
var
  Opt: TOptionObj;
begin
Opt := TOptionObj.Create;
Opt.Value := Value;
Opt.Selected := Selected;
TheOptions.AddObject(S, Opt);
Longest := IntMax(Longest, Length(S));
end;

procedure TListBoxFormControlObj.ResetToValue;
var
  I: Integer;
  Tmp: boolean;
begin
with (FControl as TListBox) do
  begin
  Clear;
  for I := 0 to TheOptions.Count-1 do
    begin
    Items.Add(TheOptions[I]);
    Tmp := (TheOptions.Objects[I] as TOptionObj).Selected;
    if MultiSelect then
      Selected[I] := Tmp
    else if Tmp then
      ItemIndex := I;
    end;
  if ItemIndex < 0 then
    ItemIndex := 0;
  TopIndex := 0;
  end;
end;

procedure TListBoxFormControlObj.SetHeightWidth(Canvas: TCanvas);
begin
if not Assigned(FControl.Parent) then
  begin
  FControl.Parent := TPaintPanel(MasterList.PPanel);
  ResetToValue;
  end;
with TListBox(FControl) do
  begin
  Canvas.Font := Font;
  if LBSize = -1 then LBSize := IntMax(1, IntMin(8, TheOptions.Count)); 
  ClientHeight := Canvas.TextHeight('A')*LBSize;
  ClientWidth := Canvas.TextWidth('A')*Longest + 15;
  end;
end;

function TListBoxFormControlObj.GetSubmission(Index: integer;
              var S: string): boolean;
begin
with (FControl as TListBox) do
  if (Index < Items.Count) then
      begin
      Result := True;
      S := '';
      if MultiSelect and Selected[Index] or
                     not MultiSelect and (ItemIndex = Index) then
        begin
        S := Self.Name+'=';
        with TheOptions.Objects[Index] as TOptionObj do
          if Value <> '' then S := S + Value
          else S := S + Items[Index];
        end;
    end
  else Result := False;
end;

{----------------TComboFormControlObj.Create}
constructor TComboFormControlObj.Create(AMasterList: TSectionList;
            Position: integer; L: TAttributeList);
var
  PntPanel: TPaintPanel;
begin
inherited Create(AMasterList, Position, L);
PntPanel := TPaintPanel(AMasterList.PPanel);
FControl.Free;   {don't want the inherited one}
FControl := TComboBox.Create(PntPanel);
with TComboBox(FControl) do
  begin
  Top := -400;   {so will be invisible until placed}
  Font.Name := AMasterList.PreFontName;
  Font.Size := 10;
  Style := csDropDownList;
  OnEnter := EnterEvent;    
  OnExit := ExitEvent;
  OnDropDown := FormControlClick;   
  OnClick := FormControlClick;   
  end;
end;

procedure TComboFormControlObj.ResetToValue;
var
  I: Integer;
begin
with (FControl as TComboBox) do
  begin
  Clear;
  for I := 0 to TheOptions.Count-1 do
    begin
    Items.Add(TheOptions[I]);
    if (TheOptions.Objects[I] as TOptionObj).Selected then
      ItemIndex := I;
    end;
  if ItemIndex < 0 then
    ItemIndex := 0;
  end;
end;

procedure TComboFormControlObj.SetHeightWidth(Canvas: TCanvas);
var
  Wid: integer;
  DC: HDC;
  A: Char;
  ExtS: TSize;
begin
if not Assigned(FControl.Parent) then
  begin
  FControl.Parent := TPaintPanel(MasterList.PPanel);
  ResetToValue;
  end;
with TComboBox(FControl) do
  begin
  A := 'A';
  DC := GetDC(0);
  {$ifdef Windows}
  Wid := LoWord(GetTextExtent(DC, @A, 1));
  {$else}
  GetTextExtentPoint32(DC, @A, 1, ExtS);
  Wid := ExtS.cx;
  {$endif}
  ReleaseDC(0, DC);
  ClientWidth := Wid * Longest + 30;
  end;
end;

function TComboFormControlObj.GetSubmission(Index: integer;
              var S: string): boolean;
begin
with (FControl as TComboBox) do
  if (Index < Items.Count) then
      begin
      Result := True;
      S := '';
      if ItemIndex = Index then
        begin
        S := Self.Name+'=';
        with TheOptions.Objects[Index] as TOptionObj do
          if Value <> '' then S := S + Value
          else S := S + Items[Index];
        end;
    end
  else Result := False;
end;

{----------------TTextAreaFormControlObj.Create}
constructor TTextAreaFormControlObj.Create(AMasterList: TSectionList;
            Position: integer; L: TAttributeList);
var
  PntPanel: TPaintPanel;
  I: integer;
  Wrap: boolean;
  SB: TScrollStyle;
begin
inherited Create(AMasterList, Position, L);
TheText := TStringList.Create;
Rows := 5;
Cols := 30;
Wrap := False;
SB := ssBoth;

for I := 0 to L.Count-1 do
  with TAttribute(L[I]) do
    case Which of
      RowsSy: Rows := Value;
      ColsSy: Cols := Value;
      WrapSy:
        if (Lowercase(Name) = 'soft') or (Lowercase(Name) = 'hard') then
          begin
          SB := ssVertical;
          Wrap := True;
          end;
      end;

PntPanel := TPaintPanel(AMasterList.PPanel);
FControl := TMemo.Create(PntPanel);
with TMemo(FControl) do
  begin
  Top := -400;   {so will be invisible until placed}
  Font.Name := AMasterList.PreFontName;
  Font.Size := 10;
  ScrollBars := SB;
  Wordwrap := Wrap;
  OnKeyDown := MyForm.ControlKeyDown;
  OnEnter := EnterEvent;
  OnExit := ExitEvent;
  OnClick := FormControlClick;
  end;
end;

destructor TTextAreaFormControlObj.Destroy;
begin
TheText.Free;
inherited Destroy;
end;

procedure TTextAreaFormControlObj.SetHeightWidth(Canvas: TCanvas);
begin
if not Assigned(FControl.Parent) then  
  begin
  FControl.Parent := TPaintPanel(MasterList.PPanel);
  ResetToValue;
  end;
with TMemo(FControl) do
  begin
  Canvas.Font := Font;
  ClientHeight := Canvas.TextHeight('A')*Rows + 5;
  ClientWidth := Canvas.TextWidth('A')*Cols + 5;
  end;
end;

procedure TTextAreaFormControlObj.AddStr(const S: string);
begin
TheText.Add(S);
end;

procedure TTextAreaFormControlObj.ResetToValue;
begin
with (FControl as TMemo) do
  begin
  Lines := TheText;
  SelStart := 0;
  SelLength := 0;
  end;
end;

function TTextAreaFormControlObj.GetSubmission(Index: integer;
              var S: string): boolean;
var
  I: integer;
begin
if Index = 0 then
  begin
  Result := True;
  S := Name+'=';
  with (FControl as TMemo) do
    for I := 0 to Lines.Count-1 do
      begin
      S := S + Lines[I];
      if (I < Lines.Count-1) and not WordWrap then
        S := S + ^M^J;
      end;
  end
else Result := False;
end;

function TFormControlList.FindControl(Posn: integer): TFormControlObj;
{find the control at a given character position}
var
  I: integer;
begin
for I := 0 to Count-1 do
  if TFormControlObj(Items[I]).Pos = Posn then
    begin
    Result := Items[I];
    Exit;
    end;
Result := Nil;
end;

function TFormControlList.GetHeightAt(Posn: integer;
              var BaseLine: boolean) : Integer;
var
  Ctrl: TFormControlObj;
begin
Ctrl := FindControl(Posn);
if Assigned(Ctrl) then
  begin
  Result := Ctrl.FControl.Height;
  BaseLine := Ctrl.BaseLine;
  end
else Result := -1;
end;

function TFormControlList.GetWidthAt(Posn: integer) : integer;
var
  Ctrl: TFormControlObj;
begin
Ctrl := FindControl(Posn);
if Assigned(Ctrl) then
  Result := Ctrl.FControl.Width
else Result := -1;
end;

function TFormControlList.GetControlCountAt(Posn: integer): integer;
{Return count of chars before the next form control.  0 if at the control,
 9999 if no controls after Posn}
var
  I, Pos: integer;
begin
if Count = 0 then
  begin
  Result := 9999;
  Exit;
  end;
I := 0;
while I < count do
  begin
  Pos := TFormControlObj(Items[I]).Pos;
  if Pos >= Posn then break;
  Inc(I);
  end;
if I = Count then Result := 9999
else
  Result := TFormControlObj(Items[I]).Pos - Posn;
end;

end.
